home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 3 / CD ACTUAL 3.iso / linux / incoming / jstools-.6v3 / jstools- / jstools-tk3.6v3.0 / lib / jfs.tcl < prev    next >
Encoding:
Text File  |  1995-02-09  |  8.7 KB  |  326 lines
  1. # jfs.tcl - file-selection panel
  2. # 
  3. # Copyright 1992-1994 by Jay Sekora.  All rights reserved, except 
  4. # that this file may be freely redistributed in whole or in part 
  5. # for non-profit, noncommercial use.
  6. # 
  7. # these procedures are required by (at least)
  8. #     browser.tk
  9. #     edit.tk
  10. #     more.tk
  11. #     people.tk
  12. ######################################################################
  13.  
  14. ### TO DO
  15. ###   more error-checking in j:fs
  16. ###   fix focus on j:fs
  17. ###   option for load/save?
  18. ###   mkdir when saving?
  19. ###   `default' behaviour needs fixed (do we even need a default now?)
  20.  
  21. ### CHANGES
  22. ###   j:fs now no longer does a cd (well, it does, but it un-does it)
  23.  
  24. ######################################################################
  25. # global variables:
  26. #
  27. global J_PREFS env
  28. if {! [info exists J_PREFS(autoposition)]} {set J_PREFS(autoposition) 0}
  29. if {! [info exists J_PREFS(confirm)]} {set J_PREFS(confirm) 1}
  30. #
  31. ######################################################################
  32.  
  33. ######################################################################
  34. # j:fs ?options? - file selector box
  35. # options are:
  36. #   -buttons (default {ok cancel home})
  37. #   -prompt (default "Choose a file")
  38. #   -directory (default ".")
  39. #   -cancelvalue (default "")
  40. #   -fileprompt (default "File:")
  41. #   -title (default "File Selector")
  42. #   -types (default "")
  43. #   -typevariable (default "")
  44. # NOTE: this may do a cd---affects entire app!
  45. ######################################################################
  46. ### this proc is too monolithic; it should be broken up.
  47.  
  48. proc j:fs { args } {
  49.   j:parse_args {
  50.     {buttons {ok cancel home} }
  51.     {prompt "Choose a file"}
  52.     {directory "."}
  53.     {cancelvalue ""}
  54.     {fileprompt "File:"}
  55.     {title "File Selector"}
  56.     {types ""}
  57.     {typevariable ""}
  58.     {typeprompt "File type:"}
  59.   }
  60.     
  61.   global j_fs env J_PREFS
  62.   global fs_defaultbutton
  63.   set J_PREFS(0) 1        ;# make sure it's intepreted as array
  64.   
  65.   if {[lsearch [array names J_PREFS] {j_fs_fast}] == -1} {
  66.     set J_PREFS(j_fs_fast) 0    ;# make sure it's defined
  67.   }
  68.   if {[lsearch [array names J_PREFS] {scrollbarside}] == -1} {
  69.     set J_PREFS(scrollbarside) right ;# make sure it's defined
  70.   }
  71.   
  72.   set old_cwd [pwd]        ;# save current directory to un-do cd's
  73.   
  74.   set dir $directory
  75.   set file ""
  76.  
  77.   if {![file isdirectory $dir]} {
  78.     set dir .
  79.   }
  80.  
  81.   set fs_defaultbutton [lindex $buttons 0]
  82.  
  83.   set j_fs(result) $file
  84.   set j_fs(type) {}
  85.   
  86.   j:tk3 {
  87.     set old_focus [focus]        ;# so we can restore original focus
  88.   }
  89.   j:tk4 {
  90.     set old_focus [focus -lastfor .]    ;# so we can restore original focus
  91.   }
  92.   
  93.   if [winfo exists .fs] {
  94.     destroy .fs
  95.   }
  96.  
  97.   cd $dir
  98.  
  99.   toplevel .fs
  100.   wm title .fs $title
  101.   wm minsize .fs 10 10
  102.  
  103.   label .fs.prompt -anchor w -text $prompt
  104.   label .fs.cwd -text [pwd]
  105.   frame .fs.list
  106.   listbox .fs.list.lb -yscroll ".fs.list.sb set"
  107.   j:tk3 {.fs.list.lb configure -geometry 30x20}
  108.   j:tk4 {.fs.list.lb configure -width 30 -height 20}
  109.   scrollbar .fs.list.sb -relief flat -command ".fs.list.lb yview"
  110.   frame .fs.file
  111.   label .fs.file.l -text $fileprompt -anchor e
  112.   entry .fs.file.e -relief sunken -text $file
  113.   
  114.   if {"x$types" != "x" && "x$typevariable" != "x"} {
  115.     frame .fs.type
  116.     label .fs.type.l -text $typeprompt -anchor e
  117.     j:option .fs.type.o -list $types
  118.     pack .fs.type.l -side left -pady 10 -padx 10
  119.     pack .fs.type.o -side left -expand yes -pady 10 -padx 10 -fill x
  120.   }
  121.  
  122.   frame .fs.b -width 200
  123.   button .fs.b.ok -width 8 -text {OK} -command {
  124.     set file [.fs.file.e get]
  125.     if {[file isdirectory ./$file]} {
  126.       cd $file            ;# cd into directory, refresh list
  127.       .fs.cwd configure -text [pwd]
  128.       j:fs:fill_list .fs.list.lb
  129.       .fs.file.e delete 0 end    ;# clear filename space
  130.     } else {
  131.       set cwd [pwd]
  132.       if {$cwd == "/"} {set cwd ""}
  133.       set file [.fs.file.e get]
  134.       case $file in {
  135.         /*    {set j_fs(result) $file}
  136.         default {set j_fs(result) $cwd/$file}
  137.       }
  138.       if [winfo exists .fs.type.o] {
  139.         set j_fs(type) [.fs.type.o get]
  140.       }
  141.       
  142.       destroy .fs
  143.       update
  144.     }
  145.   }
  146.   button .fs.b.gointo -width 8 -text "Go Into" -command {
  147.     set file [.fs.file.e get]
  148.     if {[file isdirectory ./$file]} {
  149.       cd $file            ;# cd into directory, refresh list
  150.       .fs.cwd configure -text [pwd]
  151.       j:fs:fill_list .fs.list.lb
  152.       .fs.file.e delete 0 end    ;# clear filename space
  153.     } else {
  154.       j:alert -text "\"$file\" is not a directory."
  155.     }
  156.   }
  157.   button .fs.b.home -width 8 -text {Home} -command {
  158.     cd $env(HOME)
  159.     .fs.cwd configure -text [pwd]
  160.     j:fs:fill_list .fs.list.lb
  161.   }
  162.   button .fs.b.root -width 8 -text {Root} -command {
  163.     cd /
  164.     .fs.cwd configure -text [pwd]
  165.     j:fs:fill_list .fs.list.lb
  166.   }
  167.   button .fs.b.here -width 8 -text {Here} -command {
  168.     set j_fs(result) [pwd]
  169.     
  170.     # need for following is probably pretty rare:
  171.     if [winfo exists .fs.type.o] {
  172.       set j_fs(type) [.fs.type.o get]
  173.     }
  174.       
  175.  
  176.     destroy .fs
  177.     update
  178.   }
  179.   button .fs.b.cancel -width 8 -text {Cancel} -command "
  180.     set j_fs(result) $cancelvalue
  181.     destroy .fs
  182.     update
  183.   "
  184.   checkbutton .fs.b.fast -text {Fast} -relief flat \
  185.     -variable J_PREFS(j_fs_fast)
  186.  
  187.   pack .fs.list.sb -side $J_PREFS(scrollbarside) -fill y
  188.   pack [j:rule .fs.list] -side $J_PREFS(scrollbarside) -fill y
  189.   pack .fs.list.lb -side left -expand yes -fill both
  190.   
  191.   pack .fs.file.l -side left -pady 10 -padx 10
  192.   pack .fs.file.e -side left -expand yes -pady 10 -padx 10 -fill x
  193.   pack [j:filler .fs.file] -side left
  194.   
  195.   # now create the buttons the caller requested:
  196.   #    (NEEDS ERROR CHECKING!)
  197.   pack [j:filler .fs.b] -side bottom
  198.   pack .fs.b.fast -side top
  199.   foreach b $buttons {
  200.     set button .fs.b.$b
  201.     set border .fs.b.border_$b
  202.     frame $border -borderwidth 1 -relief flat
  203.     raise $button
  204.     pack $button -in $border -padx 2 -pady 2
  205.     pack $border -in .fs.b -side bottom -padx 10 -pady 4
  206.   }
  207.   # wider border on default button:
  208.   .fs.b.border_$fs_defaultbutton configure -relief sunken
  209.  
  210.   pack .fs.prompt -side top -fill both
  211.   pack [j:rule .fs] -side top -fill x
  212.   pack .fs.cwd -side top -fill both
  213.   pack [j:rule .fs] -side top -fill x
  214.   pack .fs.file -side bottom -expand yes -fill x
  215.   pack [j:rule .fs] -side bottom -fill x
  216.   if [winfo exists .fs.type] {
  217.     pack .fs.type -side bottom -expand yes -fill x
  218.     pack [j:rule .fs] -side bottom -fill x
  219.   }
  220.   pack \
  221.     .fs.b \
  222.     [j:rule .fs] \
  223.     -side right -fill y
  224.   pack .fs.list -side top -expand yes -fill both
  225.  
  226.   j:dialogue .fs        ;# position in centre of screen
  227.  
  228.   .fs.file.e insert end $j_fs(result)
  229.  
  230.   focus .fs.file.e
  231.   bind .fs.file.e <Key-Return> {
  232.     set file [.fs.file.e get]
  233.     if {$file != {} && [file isdirectory ./$file]} {
  234.       .fs.b.gointo invoke
  235.     } else {
  236.       .fs.b.$fs_defaultbutton invoke
  237.     }
  238.   }
  239.   bind .fs.file.e <Key-Tab> {    ;# expand filename on <Tab>
  240.     set f [%W get]
  241.     %W delete 0 end
  242.     %W insert end [j:expand_filename $f]
  243.   }
  244.   bind .fs.list.lb <Button-1> {    ;# select, and insert filename into entry
  245.     j:tk3 {
  246.       %W select from [%W nearest %y]
  247.     }
  248.     j:tk4 {
  249.       %W selection clear 0 end; %W selection set [%W nearest %y]
  250.     }
  251.     set file [lindex [selection get] 0]
  252.     .fs.file.e delete 0 end
  253.     .fs.file.e insert end $file
  254.   }
  255.  
  256.   bind .fs.list.lb <Double-Button-1> {    ;# cd to dir or do default thing
  257.     set file [lindex [j:selection_if_any] 0]
  258.     if [file isdirectory ./$file] {
  259.       .fs.b.gointo invoke
  260.     } else {
  261.       .fs.b.$fs_defaultbutton invoke
  262.     }
  263.   }
  264.   
  265.   j:cancel_button .fs.b.cancel .fs.file.e
  266.  
  267. #  grab .fs            ;# for some reason this screws up 
  268.                 ;#   "bind .fs.list.lb <Double-Button-1> ..."
  269.  
  270.   j:fs:fill_list .fs.list.lb    ;# fill the listbox for the first time
  271.   tkwait window .fs
  272.   cd $old_cwd            ;# leave application in original dir.
  273.   focus $old_focus
  274.   
  275.   if {"x$types" != "x" && "x$typevariable" != "x"} {
  276.     global OPTION_FOR_.fs.option.o
  277.     uplevel 1 [list set $typevariable $j_fs(type)]
  278.   }
  279.   
  280.   return $j_fs(result)
  281. }
  282.  
  283. ######################################################################
  284. # j:fs:fill_list lb - fill the listbox with files from CWD
  285. ######################################################################
  286.  
  287. proc j:fs:fill_list {lb} {
  288.   global J_PREFS
  289.   set J_PREFS(0) 1
  290.   $lb delete 0 end
  291.  
  292.   # add ".." to go up a level:
  293.   $lb insert end ".."
  294.  
  295.   update
  296.  
  297.   # add all normal (non-dot) files:
  298.   foreach i [lsort [glob -nocomplain *]] {
  299.     if { ! $J_PREFS(j_fs_fast) } {
  300.       if {[file isdirectory ./$i]} {
  301.         $lb insert end "$i/"
  302.       } else {
  303.         $lb insert end $i
  304.       }
  305.     } else {
  306.       $lb insert end $i
  307.     }
  308.   }
  309.  
  310.   # add any dot-files:
  311.   foreach i [lsort [glob -nocomplain .*]] {
  312.     if {$i != "." && $i != ".."} {
  313.       if { ! $J_PREFS(j_fs_fast) } {
  314.         if {[file isdirectory ./$i]} {
  315.           $lb insert end "$i/"
  316.         } else {
  317.           $lb insert end $i
  318.         }
  319.       } else {
  320.         $lb insert end $i
  321.       }
  322.     }
  323.   }
  324. }
  325.  
  326.